home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / diskutil / salvage.lzh / salvage.pas next >
Pascal/Delphi Source File  |  1990-03-15  |  8KB  |  252 lines
  1. {A program to aid in the salvage of the text portions of a floppy disk.
  2. Applies to a disk where the directory or FAT tables are trashed.
  3. Phase 1 helps identify, rapidly, which sectors contain text.  Phase two of
  4. the program copies selected sectors to a file on a different disk.
  5.  
  6.                   Author        : Merlin L. Hanson
  7.                   Genie address : M.L.HANSON
  8.                   Language      : Personal Pascal II
  9.                   Date          : Feb 1990
  10.                   Version       : 1.0   }
  11.  
  12. PROGRAM Salvage;
  13. (*$I GEMSUBS.PAS*)
  14. TYPE
  15.   C_String = PACKED ARRAY[0..255] OF char;
  16.  
  17. (*$I AUXSUBS.PAS*)  
  18.  
  19. PROCEDURE DoIt;
  20.   TYPE
  21.     T1 = PACKED ARRAY[1..512]OF char;
  22.   VAR
  23.     SectorNbr,LastSector,junk : integer;
  24.     MyBuffer  : T1;
  25.     Status    : long_integer;
  26.     S         : string;
  27.  
  28. {$P-}
  29.   PROCEDURE LoadDisk;
  30.   
  31.     PROCEDURE GetNumberLastSector(VAR N:integer);
  32.       TYPE 
  33.         T1 = ^T2;
  34.         T2 = ARRAY[1..9] OF integer;
  35.       VAR
  36.         MyPtr   : T1;
  37.         liar : RECORD
  38.                  CASE {tagid} integer OF
  39.                    1 : (a : long_integer);
  40.                    2 : (b : T1);
  41.                END {record};    
  42.     
  43.       FUNCTION GetBPB(Device:integer):long_integer;
  44.         {Result is actually a pointer to an integer array in TOS's area.}
  45.         BIOS(7);
  46.         
  47.       BEGIN {getnumberlastsector}
  48.         liar.a := GetBPB(0  {Drive A}  );
  49.         N := liar.b^[7] + liar.b^[8] * 2 - 1;
  50.       END {getnumberlastsector};
  51.  
  52.     BEGIN {loaddisk}
  53.       junk := DO_ALERT(
  54.         '[0][Load the subject disk|    in drive A:\][ OK ]',1);
  55.       GetNumberLastSector(LastSector);
  56.     END {loaddisk};
  57. {$P+}    
  58.  
  59.   PROCEDURE ReadOneSector(Sector:integer;  VAR Error:boolean);
  60.     {Read the specified logical sector.  It there is an error
  61.     make one retry. If error on second try, show an error message
  62.     and set the error flag to TRUE.  I noted a lot of errors with my drive
  63.     on the first access after coming up to speed, as though there wasn't 
  64.     a sufficient time allownce. But the error code was -14, Diskette 
  65.     was changed!?}
  66.     VAR
  67.       Retry  : boolean;
  68.     
  69.     FUNCTION RWABS(rwflag:integer; VAR Buffer:T1 ; NbrSectors,RecordNbr,Device:integer)
  70.             : long_integer;
  71.       BIOS(4);
  72.       
  73.     BEGIN {readonesector}  
  74.       Retry := FALSE;
  75.       Error := FALSE;
  76.       REPEAT
  77.         Error :=  RWABS(0      {read sector},
  78.                   MyBuffer,
  79.                   1            {number of sectors},
  80.                   Sector,
  81.                   0            {drive A})      <> 0;
  82.         IF Error 
  83.           THEN
  84.             CASE Retry OF
  85.               TRUE : {This _was_ retry. Error indicator is already set.}
  86.                      WriteLn('Error on reading sector.  BIOS error code :',Error);
  87.               FALSE : Retry := TRUE;   {Try a second time.}
  88.             END {case};  
  89.       UNTIL (NOT Error) OR Retry;      
  90.     END {readonesector};
  91.  
  92.   PROCEDURE ReadTheFile;
  93.     VAR
  94.       ErrorFlag : boolean;
  95.  
  96.     PROCEDURE DisplayRecord;
  97.       VAR i:integer;
  98.       BEGIN
  99.         Write(SectorNbr,':');
  100.         FOR i := 1 TO 70 DO
  101.           IF (MyBuffer[i] >= ' ') AND (MyBuffer[i] <= '~')
  102.             THEN Write(MyBuffer[i])
  103.             ELSE Write(' ');
  104.         WriteLn;    
  105.       END {displayrecord};
  106.       
  107.       BEGIN {readthefile}
  108.         junk := DO_ALERT(
  109.           '[0][^S and ^Q control scrolling|       ^C to abort][ Fascinating! ]',1);
  110.         SectorNbr := 0;
  111.         ClrScr;
  112.         WHILE SectorNbr <= LastSector DO
  113.           BEGIN
  114.             ReadOneSector(SectorNbr,ErrorFlag);
  115.             IF NOT ErrorFlag
  116.               THEN DisplayRecord;
  117.             SectorNbr := SectorNbr + 1;
  118.           END {while};    
  119.       END {readthefile};
  120.     
  121.   PROCEDURE CopySectors;
  122.     VAR
  123.       Duplicate : {FILE OF} text;  
  124.       MyError   : boolean;
  125.       SectorNbr,First,Last,i,FileNumber : integer;
  126.  
  127.     PROCEDURE IntegerToString(N:integer; VAR S:string);
  128.       {Convert numbers up to 99 to a 3 character string
  129.       with leading zeros _not_ suppressed.}
  130.       VAR Tens,Units : integer;
  131.       BEGIN
  132.         IF N < 10
  133.           THEN
  134.             BEGIN
  135.               S    := '00';
  136.               S[3] := CHR(N + 48);
  137.             END
  138.           ELSE
  139.             BEGIN
  140.               Tens  := N DIV 10;
  141.               Units := N MOD 10;
  142.               S[1] := '0';
  143.               S[2] := CHR(Tens  + 48);
  144.               S[3] := CHR(Units + 48);
  145.             END;  
  146.         S[0] := CHR(3);  {Give the string a length.}    
  147.       END {integertostring};
  148.            
  149.     PROCEDURE GetOutputFile;
  150.       VAR
  151.         FileName,PathName : path_name;
  152.       BEGIN
  153.         GoToXY(3,29);
  154.         InverseVideo; WriteLn(' Select New file '); NormVideo;
  155.         PathName := 'E:\';
  156.         IntegerToString(FileNumber,FileName);
  157.         FileName := CONCAT(FileName,'.RCV');
  158.         IF GET_IN_FILE(PathName,FileName)
  159.           THEN 
  160.             IF PathName[1] = 'A'
  161.               THEN
  162.                 BEGIN
  163.                   junk := DO_ALERT(
  164.                     '[3][Can''t overwrite disk A:\|    Sorry][ Oh, Oh ]',1);
  165.                   HALT;
  166.                 END                        
  167.               ELSE REWRITE(Duplicate,FileName)
  168.           ELSE HALT;  {user cancel}
  169.       END {getoutputfile};
  170.  
  171.     PROCEDURE GetSectorNumbers;
  172.       VAR OK : boolean;
  173.       BEGIN
  174.         REPEAT
  175.           GoToXY(9,34);
  176.           ClrScr;
  177.           GoToXY(6,27);
  178.           Write('First sector to save? ');  ReadLn(First);
  179.           GoToXY(7,27);
  180.           Write('Last  sector to save? ');  ReadLn(Last); 
  181.           OK := (First > 0) AND (Last >= First) AND (Last <= LastSector);
  182.           IF NOT OK THEN junk := DO_ALERT(
  183.             '[0][Unaccptble choices!][ Forgive me ]',1);
  184.         UNTIL OK 
  185.       END {getsectornumbers};
  186.             
  187.     BEGIN {copysectors}
  188.       FileNumber := 1;
  189.       junk := DO_ALERT('[0][Choose CANCEL after the last file][ OK ]',1);
  190.       REPEAT
  191.       ClrScr;        
  192.       GetOutputFile;
  193.       GetSectorNumbers;
  194.       GoToXY(9,35);   WriteLn('Working ...');
  195.       FOR SectorNbr := First TO Last DO
  196.         BEGIN
  197.           ReadOneSector(SectorNbr,MyError);
  198.           IF NOT MyError
  199.             THEN Write(Duplicate,MyBuffer)
  200.             ELSE {writeblanks}
  201.               BEGIN
  202.                 FOR i := 1 TO 512 DO MyBuffer[i] := ' ';
  203.                 Write(Duplicate,MyBuffer);
  204.               END; 
  205.         END {do};
  206.       junk := DO_ALERT('[0][ File Written ][ OK ]',1);
  207.       FileNumber := FileNumber + 1;
  208.       UNTIL FALSE;  {Exit via file selector CANCEL choice.}  
  209.     END {copysectors};
  210.     
  211.   BEGIN {doit}
  212.     LoadDisk;
  213.     IF DO_ALERT(
  214.       '[2][Read file first?][ Yes | No ]',1) = 1       
  215.       THEN ReadTheFile;
  216.     IF DO_ALERT(
  217.       '[2][Copy sectors to|  another disk?][ Yes | No]',1) = 1
  218.       THEN CopySectors;
  219.   END {doit};
  220.  
  221. BEGIN  {main}
  222.   IF INIT_GEM >= 0 THEN
  223.     BEGIN
  224.       DoIt;
  225.       EXIT_GEM;
  226.     END;  
  227. END {program}.
  228. (*           ************ program structure ************
  229.    12 PROGRAM Salvage;
  230.    13 (*$I GEMSUBS.PAS*)
  231.    17 (*$I AUXSUBS.PAS*)  
  232.    19 PROCEDURE DoIt;
  233.    29  |PROCEDURE LoadDisk;
  234.    31  | |PROCEDURE GetNumberLastSector(VAR N:integer);
  235.    43  | | |FUNCTION GetBPB(Device:integer):long_integer;
  236.    47  | | |BEGIN {getnumberlastsector}
  237.    52  | |BEGIN {loaddisk}
  238.    59  |PROCEDURE ReadOneSector(Sector:integer;  VAR Error:boolean);
  239.    69  | |FUNCTION RWABS(rwflag:integer; VAR Buffer:T1 ; NbrSectors,RecordNbr,Device:integer)
  240.    73  | |BEGIN {readonesector}  
  241.    92  |PROCEDURE ReadTheFile;
  242.    96  | |PROCEDURE DisplayRecord;
  243.   107  | | |BEGIN {readthefile}
  244.   121  |PROCEDURE CopySectors;
  245.   127  | |PROCEDURE IntegerToString(N:integer; VAR S:string);
  246.   149  | |PROCEDURE GetOutputFile;
  247.   171  | |PROCEDURE GetSectorNumbers;
  248.   187  | |BEGIN {copysectors}
  249.   211  |BEGIN {doit}
  250.   221 BEGIN  {main}                   *)
  251.  
  252.